Attribute VB_Name = "XPStyle"
'#######################################################
'##################### XPStyle.bas #####################
'#######################################################
'####### Provide the XP Style to your application ######
'##### Do NOT Call CreateManifest() in debug mode ! ####
'#######################################################
'############ By Guillaume Huysmans, 2006 ##############
'############ EMail : Ghuysmans@Skynet.be ##############
'#######################################################
Option Explicit
Private Declare Function InitCommonControls Lib "comctl32.dll" () As Long
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, _
                                                                                      ByVal lpFileName As String, _
                                                                                      ByVal nSize As Long) As Long
Public Sub InitXPStyle()
  If Not DebugMode Then
  If Not ManifestExist(App.EXEName) Then
   CreateManifest App.EXEName
   Shell App.Path & "\" & App.EXEName & ".exe", vbNormalFocus
   End
  Else
   InitCommonControls
  End If
 Else
  InitCommonControls
 End If
End Sub
Private Function ManifestExist(xEXEName As String) As Boolean
Dim FSO As Object
 Set FSO = CreateObject("Scripting.FileSystemObject")
 ManifestExist = FSO.FileExists(App.Path & "\" & xEXEName & ".exe.manifest")
End Function
Public Sub CreateManifest(xEXEName As String)
Dim FSO As Object
 Set FSO = CreateObject("Scripting.FileSystemObject")
 Dim TextFile As Object
 Set TextFile = FSO.CreateTextFile(App.Path & "\" & xEXEName & ".exe.manifest")
 Dim Content As String
 Content = "<?xml version='1.0' encoding='UTF-8' standalone='yes'?>" & vbCrLf
 Content = Content & "<assembly xmlns='urn:schemas-microsoft-com:asm.v1' manifestVersion='1.0'>" & vbCrLf
 Content = Content & "<assemblyIdentity" & vbCrLf
 Content = Content & "    version='" & App.Major & "." & App.Minor & "." & App.Revision & ".0'" & vbCrLf
 Content = Content & "    processorArchitecture='X86'" & vbCrLf
 Content = Content & "    name='" & App.Title & "'" & vbCrLf
 Content = Content & "    type='win32'" & vbCrLf
 Content = Content & "/>" & vbCrLf
 Content = Content & "<description>WindowsExecutable</description>" & vbCrLf
 Content = Content & "<dependency>" & vbCrLf
 Content = Content & "    <dependentAssembly>" & vbCrLf
 Content = Content & "        <assemblyIdentity" & vbCrLf
 Content = Content & "            type='win32'" & vbCrLf
 Content = Content & "            name='Microsoft.Windows.Common-Controls'" & vbCrLf
 Content = Content & "            version='6.0.0.0'" & vbCrLf
 Content = Content & "            processorArchitecture='X86'" & vbCrLf
 Content = Content & "            publicKeyToken='6595b64144ccf1df'" & vbCrLf
 Content = Content & "            language='*'" & vbCrLf
 Content = Content & "        />" & vbCrLf
 Content = Content & "    </dependentAssembly>" & vbCrLf
 Content = Content & "</dependency>" & vbCrLf
 Content = Content & "</assembly>"
 Content = Replace(Content, "'", Chr(34))
 TextFile.Write Content
 TextFile.Close
 Set TextFile = Nothing
 Set FSO = Nothing
End Sub
'#########################################################
'#################### VERIF DEBUG MODE ###################
Public Function DebugMode() As Boolean
Dim strFileName As String
 strFileName = String(255, 0)
 DebugMode = Not (UCase(Right(Left(strFileName, GetModuleFileName(App.hInstance, strFileName, 255)), 7)) <> "VB6.EXE")
End Function
'#########################################################
